home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / misc / dostop.c < prev    next >
C/C++ Source or Header  |  1997-02-08  |  2KB  |  73 lines

  1. /* dostop.c                                              -*- C -*- */
  2. /*
  3.  
  4. Copyright (C) 1992, 1993 John W. Eaton
  5.  
  6. This file is part of Octave.
  7.  
  8. Octave is free software; you can redistribute it and/or modify it
  9. under the terms of the GNU General Public License as published by the
  10. Free Software Foundation; either version 2, or (at your option) any
  11. later version.
  12.  
  13. Octave is distributed in the hope that it will be useful, but WITHOUT
  14. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16. for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with Octave; see the file COPYING.  If not, write to the Free
  20. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22. */
  23.  
  24. /* Modified by Klaus Gebhardt, 1996 */
  25.  
  26. #ifdef HAVE_CONFIG_H
  27. #include <config.h>
  28. #endif
  29.  
  30. #include <stdlib.h>
  31. #include <string.h>
  32.  
  33. #include "f77-fcn.h"
  34. #include "lo-error.h"
  35.  
  36. #ifdef __EMX__
  37. int f77_exception_encountered;
  38. jmp_buf f77_context;
  39. #endif
  40.  
  41. /* All the STOP statements in the Fortran routines have been replaced
  42.    with a call to XSTOPX, defined in the file libcruft/misc/xstopx.f.
  43.  
  44.    The XSTOPX function calls this function, which will longjmp back to
  45.    the entry point for the Fortran function that called us.   Then the
  46.    calling function should do whatever cleanup is necessary. */
  47.  
  48. volatile void
  49. #if defined (F77_APPEND_UNDERSCORE)
  50. dostop_ (const char *s, const int *slen)
  51. #else
  52. dostop (const char *s, const int *slen)
  53. #endif
  54. {
  55.   int len = *slen;
  56.   if (len > 0)
  57.     {
  58.       char *tmp = malloc (len + 1);
  59.       strncpy (tmp, s, len);
  60.       (*current_liboctave_error_handler) ("%s", tmp);
  61.       free (tmp);
  62.     }
  63.  
  64.   longjmp (f77_context, 1);
  65. }
  66.  
  67. /*
  68. ;;; Local Variables: ***
  69. ;;; mode: C ***
  70. ;;; page-delimiter: "^/\\*" ***
  71. ;;; End: ***
  72. */
  73.